home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pgraph.zip / PASCAL.ZIP / DEMO_SCR.PAS next >
Pascal/Delphi Source File  |  1991-10-14  |  7KB  |  215 lines
  1. unit demo_scr;
  2.  
  3. {*******************************************************************
  4.  *                                                                  *
  5.  *  'Printer Graphics Interface' Demonstration Program              *
  6.  *  Screen Output Module                                            *
  7.  *                                                                  *
  8.  *  Main program: DEMO.PAS                                                        *
  9.  *  Author: F van der Hulst                                         *
  10.  *                                                                  *
  11.  * Revisions:                                                       *
  12.  * 27 March   1991: Initial release (Turbo C v2.0 only)             *
  13.  * 07 April   1991: Ported to MicroSoft C v5.1                      *
  14.  * 15 October 1991: Rewritten in Turbo-Pascal                       *
  15.  *                                                                  *
  16.  *******************************************************************}
  17.  
  18. {$B-} { Short circuit boolean evaluation }
  19. {$I-} { I/O checking    OFF   }
  20. {$R-} { Range checking  OFF   }
  21. {$S-} { Stack checking  OFF   }
  22. {$V-} { Var-str check   OFF   }
  23.  
  24. interface
  25. uses pgraph, crt, graph, demo_sub, various;
  26.  
  27. const    MAX_WIDTH   = 801;
  28.  
  29. CONST
  30.   UnitVersion           = '1.00' ;
  31.   UnitVerDate           = '10 Sep 91' ;
  32.  
  33. procedure image_demo;
  34. procedure view_demo;
  35. procedure start_screen_output;
  36. procedure stop_screen_output;
  37.  
  38. implementation
  39.  
  40. {*******************************************************************
  41.  Draw an elliptical pie chart on the printer. }
  42.  
  43. procedure draw_elliptical_pie;
  44. begin
  45.     p_setviewport(0, 0, 500, 120, 0);
  46.     p_outtextxy(300, 50, 'Elliptical Pie chart');
  47.     p_setlinestyle(SolidLn, 0, NormWidth);
  48.     p_setfillstyle(CLOSEDOTFILL, 1);
  49.     p_sector(150, 50, 0, 50, 75, 30);
  50.     p_setfillstyle(HATCHFILL, 1);
  51.     p_sector(150, 50, 50, 120, 75, 30);
  52.     p_setfillstyle(XHATCHFILL, 1);
  53.     p_sector(150, 50, 120, 190, 75, 30);
  54.     p_setfillstyle(WIDEDOTFILL, 1);
  55.     p_sector(150, 50, 190, 290, 75, 30);
  56.     p_setlinestyle(SOLIDLN, 0, THICKWIDTH);
  57.     p_setfillstyle(INTERLEAVEFILL, 1);
  58.     p_sector(160, 60, 290, 360, 75, 30);
  59. end;
  60.  
  61. {*******************************************************************
  62.  Switch screen to graphics mode, and start echoing printer output to
  63.  the screen. }
  64.  
  65. procedure start_screen_output;
  66. var driver, mode: integer;
  67. begin
  68.     driver := DETECT;
  69.     detectgraph(driver, mode);
  70.     case driver of
  71.     VGA, EGA: begin
  72.         driver := CGA;
  73.         mode := CGAHI;
  74.     end;
  75.     CGA: begin
  76. {        registerbgidriver(CGA_driver); }
  77.         mode := CGAHI;
  78.     end;
  79.     HERCMONO: begin
  80. {        registerbgidriver(Herc_driver); }
  81.         mode := HERCMONOHI;
  82.     end;
  83.     ATT400: mode := ATT400HI;
  84.     PC3270: mode := PC3270HI;
  85.     MCGA:    mode := MCGAHI;
  86.     end;
  87.     initgraph(driver, mode, '');
  88.     if (driver < 0) then begin
  89.         writeln('BGI Error: ', grapherrormsg(graphresult));
  90.         halt(1);
  91.     end;
  92.     __p_putpixel_screen := @putpixel;
  93.     screen_echo := true;
  94. end;
  95.  
  96. {*******************************************************************
  97.  Switch screen back to text mode, and stop echoing printer output to
  98.  the screen. }
  99.  
  100. procedure stop_screen_output;
  101. begin
  102.     closegraph;
  103.     __p_putpixel_screen := nil;
  104.     screen_echo := false;
  105. end;
  106. {*******************************************************************
  107.  Scale an image to best fit the aspect ratio of the printer. This only
  108.  works if the resulting xaspect >= yaspect }
  109.  
  110. function scale_image(var bitmap: image_type; xscale: integer): boolean;
  111. var x, y, right, bottom, old_width: integer;
  112. var new_width, new_x: integer;
  113. var source, dest, pixel: integer;
  114.  
  115. begin
  116.     if xscale = 0
  117.     then scale_image := false
  118.     else begin
  119.         right := bitmap.header[0];
  120.         bottom := bitmap.header[1];
  121.         old_width := (right+7) div 8;
  122.         new_width := (old_width + xscale - 1) div xscale;
  123.         bitmap.header[0] := new_width * 8 - 1;
  124.         for y := 0 to bottom do begin
  125.             new_x := 0;
  126.             x := 0;
  127.             while x <= right do begin
  128.                 source := y * old_width + x div 8;
  129.                 dest := y * new_width + new_x div 8;
  130.                 pixel := (bitmap.data[source] shr (7 - (x and 7))) and 1;
  131.                 bitmap.data[dest] := bitmap.data[dest] and ($FF7F shr (new_x and 7));
  132.                 bitmap.data[dest] := bitmap.data[dest] or (pixel shl (7 - (new_x and 7)));
  133.                 x := x + xscale;
  134.                 new_x := new_x + 1;
  135.             end;
  136.         end;
  137.         scale_image := true;
  138.     end;
  139. end;
  140.  
  141. {*******************************************************************
  142.  Display Anne's face on the printer and screen, firstly unscaled (it
  143.  was saved as an image from a CGA screen via getimage), then scaled
  144.  to fit the printer's aspect ratio as near as possible. In between,
  145.  use putimage & getimage, and p_putimage & p_getimage, to swap characters
  146.  from the printer buffer to screen and vice versa. }
  147.  
  148. procedure image_demo;
  149.  
  150. var imagep, imageg: array [0..129] of char;
  151. var sizep: integer;
  152. var xaspp, yaspp: integer;
  153. var depth, width, left: integer;
  154. var dummy: char;
  155. var ch: char;
  156.  
  157. begin
  158.     writeln; writeln;
  159.     writeln('PICTURE DRAWING DEMO'); writeln;
  160.     width := face.header[0];
  161.     depth := face.header[1];
  162.     left := (MAX_WIDTH - width) div 2;
  163.     p_setviewport(left, 0, left + width, depth, 0);
  164.     writeln('Result = ', p_graphresult, grapherrormsg(-5));
  165.  
  166.     sizep := p_imagesize(50, 20, 60, 30);
  167.     writeln('Image size = ', sizep, ' bytes');
  168.  
  169.     start_screen_output;
  170.     p_putimage(0, 0, face, NotPut);
  171.     end_slice;
  172.     cleardevice;
  173.  
  174.     outtextxy(0,100, 'Getimage/putimage swapping screen/printer');
  175.     p_outtextxy(50, 20, 'F');
  176.     outtextxy(50, 20, 'G');
  177.     p_getimage(50, 20, 60, 30, imagep);
  178.     getimage(50, 20, 60, 30, imageg);
  179.     p_putimage(60, 20, imageg, COPYPUT);
  180.     putimage(60, 20, imagep, COPYPUT);
  181.     end_slice;
  182.     cleardevice;
  183.  
  184.     p_getaspectratio(xaspp, yaspp);
  185.     if (scale_image(face, (longint(12) * xaspp) div (yaspp * longint(5)))) then begin
  186.         outtextxy(0,180, 'Printing Scaled image');
  187.         p_outtextxy(0,150, 'Scaled');
  188.         p_putimage(0, 0, face, NOTPUT);
  189.         end_slice;
  190.     end else begin
  191.         outtextxy(0, 180, 'Can''t scale image -- Press a key to continue');
  192.         dummy := readkey;
  193.     end;
  194.     stop_screen_output;
  195. end;
  196.  
  197. {*******************************************************************
  198.  Draw a circular pie chart on the printer, then display it on the
  199.  screen. }
  200.  
  201. procedure view_demo;
  202. begin
  203.     writeln; writeln;
  204.     writeln('IMAGE VIEWING DEMO'); writeln;
  205.     writeln('Viewing Elliptical pie chart, various fill patterns');
  206.     draw_elliptical_pie;
  207.     start_screen_output;
  208.     p_view;
  209.     outtextxy(0, 180, 'Press a key to continue');
  210.     stop_screen_output;
  211. end;
  212.  
  213. BEGIN { unit body }
  214. END.  { unit body }
  215.